Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vb_ap21/vbapi.frm

Text File | 1995-09-06 | 6KB | 194 lines

VERSION 2.00
Begin Form VBAPI
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VB API Help"
   ClientHeight    =   330
   ClientLeft      =   2715
   ClientTop       =   2385
   ClientWidth     =   1560
   ControlBox      =   0   'False
   Height          =   735
   Icon            =   VBAPI.FRX:0000
   Left            =   2655
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   330
   ScaleWidth      =   1560
   Top             =   2040
   Width           =   1680
End
DefInt A-Z
Const TRUE = -1, FALSE = 0
Const HELP_QUIT = 2
Const HELP_INDEX = 3
Const LEFT_BUTTON = 1
Const RIGHT_BUTTON = 2
Const SHIFT_MASK = 1
Const CTRL_MASK = 2
Const GCW_HMODULE = (-16)
Dim XOff, YOff, Hold
Dim Mouse As POINTAPI
Declare Function WinHelp Lib "User" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, dwData As Any) As Integer
Declare Function GetModuleFileName Lib "Kernel" (ByVal hModule As Integer, ByVal lpFileName As String, ByVal nSize As Integer) As Integer
Declare Function GetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lplFileName As String) As Integer
Declare Function SetCapture Lib "User" (ByVal hWnd As Integer) As Integer
Declare Sub ReleaseCapture Lib "User" ()
Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)

Sub Form_Load ()
  Select Case WindowState
    Case 0
      Caption = ""
    Case 1
      Caption = "VB API Help"
  End Select
  PutWindow
  VBAPI.Refresh
End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  RButt = (Button And RIGHT_BUTTON) > 0
  If RButt Then
    Z = SetCapture(VBAPI.hWnd)
    GetCursorPos Mouse
    XOff = (Mouse.X * 15) - VBAPI.Left
    YOff = (Mouse.Y * 15) - VBAPI.Top
    MousePointer = 5
  End If
End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  RButt = (Button And RIGHT_BUTTON) > 0
  If RButt Then
    GetCursorPos Mouse
    XPo = Signed%((Mouse.X * 15) - XOff)
    YPo = Signed%((Mouse.Y * 15) - YOff)
    Move XPo, YPo
  End If
End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  RButt = (Button And RIGHT_BUTTON) > 0
  LButt = (Button And LEFT_BUTTON) > 0
  Ctrl = (Shift And CTRL_MASK) > 0
  Shft = (Shift And SHIFT_MASK) > 0
  If RButt Then
    GetCursorPos Mouse
    XPo = Signed%((Mouse.X * 15) - XOff)
    YPo = Signed%((Mouse.Y * 15) - YOff)
    Move XPo, YPo
    MousePointer = 0
    ReleaseCapture
  ElseIf Ctrl And LButt Then
    Unload VBAPI
  ElseIf Shft And LButt Then
    SavePosition
    WindowState = 1
  ElseIf LButt Then
    GetHelp HELP_INDEX
  End If
End Sub

Sub Form_Paint ()
  Tp = ScaleTop
  Lf = ScaleLeft + 7
  Bt = ScaleHeight - 8
  Rt = ScaleWidth - 15
  Line (Lf, Bt)-(Rt, Bt), &H808080
  Line (Rt, Tp)-(Rt, Bt), &H808080
  Line (Lf + 15, Tp + 15)-(Rt - 15, Tp + 15), &HFFFFFF
  Line (Lf + 15, Tp + 15)-(Lf + 15, Bt - 15), &HFFFFFF
  Line (Lf + 15, Bt - 15)-(Rt - 15, Bt - 15), &H808080
  Line (Rt - 15, Tp + 15)-(Rt - 15, Bt - 15), &H808080
  Lab$ = "VB API Help"
  X = (Width - TextWidth(Lab$)) \ 2
  Y = (Height - TextHeight(Lab$)) \ 2
  Col& = ForeColor
  ForeColor = &HFFFFFF
  CurrentY = Y + 15
  CurrentX = X + 15
  Print Lab$;
  ForeColor = Col&
  CurrentY = Y
  CurrentX = X
  Print Lab$;
End Sub

Sub Form_Resize ()
  Select Case WindowState
    Case 0
      If Hold Then Exit Sub
      If VBAPI.Caption <> "" Then VBAPI.Caption = ""
      PutWindow
      VBAPI.Refresh
    Case 1
      VBAPI.Caption = "VBAPI Help"
  End Select
End Sub

Sub Form_Unload (Cancel As Integer)
  GetHelp HELP_QUIT
  SavePosition
End Sub

Sub GetHelp (HlpType)
  Hlp$ = LTrim$(RTrim$(HomePath$())) + "vbapi.hlp"
  Select Case HlpType
    Case HELP_INDEX
      X = WinHelp(VBAPI.hWnd, Hlp$, HELP_INDEX, ByVal 0&)
      If X = False Then
    NL$ = Chr$(13) + Chr$(10)
    Msg$ = "Unable to access help file." + NL$ + NL$
    Msg$ = Msg$ + "Please make sure the help" + NL$
    Msg$ = Msg$ + "file (VBAPI.HLP) is in" + NL$
    Msg$ = Msg$ + "the same directory as the" + NL$
    Msg$ = Msg$ + "executable (VBAPI.EXE)."
    Tit$ = "VB API Help"
    MsgBox Msg$, 48, Tit$
      End If
    Case HELP_QUIT
      Y = WinHelp(VBAPI.hWnd, "", HELP_QUIT, ByVal 0&)
  End Select
End Sub

Function HomePath$ ()
  Hlp$ = String$(255, 0)
  hMod = GetClassWord(VBAPI.hWnd, GCW_HMODULE)
  FLn& = GetModuleFileName(hMod, Hlp$, 255)
  Hlp$ = Left$(LTrim$(RTrim$(Hlp$)), FLn& - 9)
  HomePath$ = Hlp$
  Hlp$ = ""
End Function

Sub PutWindow ()
  Hold = True
  Pf$ = LTrim$(RTrim$(HomePath$())) + "vbapi.ini"
  Lf = Screen.Width - 1410
  Tp = Screen.Height - 330
  L = GetPrivateProfileInt("Position", "Left", Lf, Pf$)
  T = GetPrivateProfileInt("Position", "Top", Tp, Pf$)
  If L > Lf Then L = Lf
  If T > Tp Then T = Tp
  Move L, T, 1410, 330
  Hold = False
End Sub

Sub SavePosition ()
  Fl$ = LTrim$(RTrim$(HomePath$())) + "vbapi.ini"
  Uh = WritePrivateProfileString("Position", "Top", LTrim$(RTrim$(Str$(VBAPI.Top))), Fl$)
  Uh = WritePrivateProfileString("Position", "Left", LTrim$(RTrim$(Str$(VBAPI.Left))), Fl$)
End Sub

Static Function Signed% (XNum&)
    If XNum& > 32767 Then
       Signed% = XNum& - 65536
    Else
       Signed% = XNum&
    End If
End Function